home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / Macintosh.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1996-02-01  |  38.0 KB  |  828 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 1 Feb 96
  5. Syntax10b.Scn.Fnt
  6. Syntax10i.Scn.Fnt
  7. Times10.Scn.Fnt
  8. MODULE Macintosh; (* mf 24.9.93*) (* mah 
  9. IMPORT
  10.     SYS := SYSTEM, Sys, Kernel;
  11. CONST
  12.     noMenu = 0;
  13.     LineLen = 512;
  14.     KeyBufLen = 127;
  15.     blackColor = 33; whiteColor = 30;
  16.     RealVector*=ARRAY 20 OF REAL;
  17.     FontMapPtr* = LONGINT; (* Should be POINTER TO FontMap except for GC *)
  18.     FontMapRealPtr* = POINTER TO FontMap;
  19.     FontMap* = RECORD
  20.         fCode: LONGINT; (*fntNum, fntSize, ordCh, y*2+1*)
  21.         width*: ARRAY 256 OF INTEGER;
  22.         height*, widMax*, ascent*, ndescent*, fntNum, fntSize, fntFace: INTEGER
  23.     END;
  24.     PatMapPtr = POINTER TO PatMap;
  25.     PatMap = RECORD (Sys.BitMap)
  26.         pattern: Sys.Pattern;
  27.         link: PatMapPtr
  28.     END;
  29.     Longword = ARRAY 4 OF CHAR;
  30.     CharPattern = ARRAY 4 OF CHAR;
  31.     MenuEventMsg = RECORD id, item: INTEGER END;
  32.     KeyEventMsg = RECORD rsvd, adr, virtual, ascii: CHAR END;
  33.     syntaxFnt*, helveticFnt*: INTEGER;
  34.     thePortClip*, userClip*: Sys.RgnHandle;
  35.     thePortW*, thePortH*, shadowH*: INTEGER;
  36.     thePortPtr*: Sys.WindowPtr; 
  37.     shadowPortPtr*: Sys.GrafPtr;
  38.     neutralizeQ*, restoreQ*, suspendQ*, resumeQ*, backgroundQ*, cmdQ*: Kernel.Queue;
  39.     macEvent*: BOOLEAN;
  40.     cmdName*: ARRAY 32 OF CHAR;
  41.     qRes*: INTEGER;
  42.     convertClip*: BOOLEAN;
  43.     nofch*, nextch*: INTEGER; keybuf*: ARRAY KeyBufLen+1 OF CHAR;
  44.     prQD*: BOOLEAN;
  45.     prOpen*: PROCEDURE(VAR name, user: ARRAY OF CHAR; password: LONGINT);
  46.     prClose*: PROCEDURE;
  47.     prPage*: PROCEDURE(nofcopies: INTEGER);
  48.     prCircle*: PROCEDURE(x0, y0, r: INTEGER);
  49.     prEllipse*: PROCEDURE(x0, y0, a, b: INTEGER);
  50.     prLine*: PROCEDURE(x0, y0, x1, y1: INTEGER);
  51.     prSpline*: PROCEDURE(x0, y0, n, open: INTEGER; VAR X, Y: ARRAY OF INTEGER);
  52.     prPicture*: PROCEDURE(x, y, w, h, mode: INTEGER; adr: LONGINT);
  53.     prUseListFont*: PROCEDURE(VAR name: ARRAY OF CHAR);
  54.     prReplConst*: PROCEDURE(x, y, w, h: INTEGER);
  55.     prReplPattern*: PROCEDURE(x, y, w, h, col: INTEGER);
  56.     prString*: PROCEDURE(x, y: INTEGER; VAR s, fname: ARRAY OF CHAR);
  57.     prContString*: PROCEDURE(VAR s, fname: ARRAY OF CHAR);
  58.     prGetMetrics*: PROCEDURE(VAR fname: ARRAY OF CHAR; VAR fdx: ARRAY OF SHORTINT; VAR found: BOOLEAN);
  59.     QD: RECORD (*QD Globals*)
  60.         privates: ARRAY 41 OF INTEGER;
  61.         screenBits: Sys.BitMap; arrow: Sys.Cursor;
  62.         dkGray, ltGray, gray, black, white: Sys.Pattern;
  63.         thePort: Sys.GrafPtr
  64.     END;
  65.     thePort: Sys.WindowPort; (* GrafPort of Oberon Display Window *)
  66.     shadowPort: Sys.GrafPort; (* GrafPort of Oberon Shadow Bitmap *)
  67.     line: ARRAY LineLen OF CHAR; llen: INTEGER; lineBuf: LONGINT; (* Line Cache *)
  68.     lcf: FontMapPtr; lcx0, lcx, lcy, lcc, lco: INTEGER; lck: LONGINT; lcm: BOOLEAN; (* Line Cache *)
  69.     ccp: CharPattern; ccf: FontMapPtr; ccdx: INTEGER; (* Character Cache *)
  70.     tpf: FontMapPtr; tpc: INTEGER; (* Primary Port *)
  71.     spf: FontMapPtr; spc: INTEGER; (* Secondary Port *)
  72.     ppf: FontMapPtr; (* Printer Port *)
  73.     inverse*, keytrans: ARRAY 256 OF CHAR; (* Bit Flipping and Key Translation *)
  74.     xlim, ylim: INTEGER; grafArea: Sys.Rect; (* Bounds for Mouse and for DragWindow *)
  75.     obnArrow: Sys.Cursor; obnMenus: Sys.MBarHnd; (* Oberon Mouse Pointer / Oberon Menu List *)
  76.     patMaps: PatMapPtr; (* Linked List, Prevent Garbage Collection *)
  77.     scrap: Sys.TEHandle; style: Sys.TEStyleHandle; text, textHandle: LONGINT; pos, max: INTEGER; (* Clipboard support *)
  78.     osyntaxFnt: INTEGER; defaultFontName: ARRAY 32 OF CHAR; (*Font Translation*)
  79.     redP, greenP, blueP: ARRAY 256 OF INTEGER; shadowColor: ARRAY 16 OF LONGINT;
  80.     vblTask : Sys.VBLTask;    (* variables for keyboard interrupt *)
  81.     suspended: BOOLEAN;
  82.     kbdIntPC*, kbdIntInstr*: LONGINT;    (* position and old value of patched code *)
  83.     p : PROCEDURE (t: LONGINT);    (* procedure variable vor registration of VBL interrupt *)
  84.     pressed: BOOLEAN;                    (* set if breakkey was pressed. Avoid cascades of break windows *)
  85.     Gestalt: PROCEDURE (sel: LONGINT; VAR  response: LONGINT): LONGINT;
  86.     RGBForeColor: PROCEDURE (rgb: Sys.RGBColor);
  87.     trueColor: BOOLEAN;
  88.     pc1, pc2: LONGINT;
  89.     bitmapSyntax: BOOLEAN;
  90. (*xxtop, xxleft, xxX, xxY: INTEGER;    (*left margin of current line*)
  91. PROCEDURE SetXY (x, y: INTEGER);
  92. BEGIN
  93.     xxleft := x; xxtop := y; xxX := xxleft; xxY := xxtop
  94. END SetXY;
  95. PROCEDURE Ch (ch: CHAR);
  96.     VAR w: INTEGER;
  97. BEGIN
  98.     w := Sys.CharWidth(ORD(ch));
  99.     Sys.MoveTo(xxX, xxY);
  100.     Sys.DrawChar(ORD(ch));
  101.     INC(xxX, w)
  102. END Ch;
  103. PROCEDURE NL;
  104. BEGIN
  105.     xxY := xxY + 12; xxX := xxleft;
  106. END NL;
  107. PROCEDURE Str (s: ARRAY OF CHAR);
  108.     VAR i: INTEGER;
  109. BEGIN
  110.     i := 0; WHILE s[i] # 0X DO Ch(s[i]); INC(i) END
  111. END Str;
  112. PROCEDURE Int (n: LONGINT);
  113.     VAR d: ARRAY 10 OF CHAR; i: INTEGER;
  114. BEGIN
  115.     IF n < 0 THEN Ch("-"); n := -n END;
  116.     i := 0; REPEAT d[i] := CHR(30H + n MOD 10); n := n DIV 10; INC(i) UNTIL n = 0;
  117.     REPEAT DEC(i); Ch(d[i]) UNTIL i = 0
  118. END Int;
  119. (* Pascal Strings *)
  120.     PROCEDURE SetStr255* (VAR theStr255: Sys.Str255; chars: ARRAY OF CHAR);
  121.         VAR i: INTEGER; ch: CHAR;
  122.     BEGIN i := 0; REPEAT ch := chars[i]; INC(i); theStr255[i] := ch UNTIL (ch = 0X) OR (i=256);
  123.         theStr255[0] := CHR(i-1)
  124.     END SetStr255;
  125.     PROCEDURE GetStr255* (VAR theStr255: Sys.Str255; VAR chars: ARRAY OF CHAR);
  126.         VAR n: INTEGER; ch: CHAR;
  127.     BEGIN n := ORD(theStr255[0]); IF LEN(chars) < n THEN n := SHORT(LEN(chars)) END;
  128.         chars[n] := 0X; WHILE n > 0 DO ch := theStr255[n]; DEC(n); chars[n] := ch END
  129.     END GetStr255;
  130. (* Display Window *)
  131.     PROCEDURE UpdateOberonWindow*;
  132.     BEGIN
  133.         IF thePort.visible THEN Sys.SetPort(thePort);
  134.             neutralizeQ.Handle(); Sys.BeginUpdate(thePort); restoreQ.Handle(); Sys.EndUpdate(thePort) 
  135.         END
  136.     END UpdateOberonWindow;
  137.     PROCEDURE ShowOberonWindow*;
  138.     BEGIN Sys.ShowWindow(thePort); Sys.SelectWindow(thePort)
  139.     END ShowOberonWindow;
  140.     PROCEDURE HideOberonWindow*;
  141.     BEGIN Sys.HideWindow(thePort)
  142.     END HideOberonWindow;
  143.     PROCEDURE FlushCache*;
  144.     VAR fnt : FontMapRealPtr; rgb: Sys.RGBColor;
  145.     BEGIN
  146.         IF llen > 0 THEN
  147.             fnt:=SYS.VAL (FontMapRealPtr, lcf);
  148.             IF lcm THEN
  149.                 IF SYS.VAL (LONGINT, QD.thePort) # SYS.VAL (LONGINT, thePortPtr) THEN Sys.SetPort(thePort) END;
  150.                 IF thePort.clipRgn # lck THEN Sys.SetClip(lck) END;
  151.                 IF tpc # lcc THEN
  152.                     IF trueColor THEN
  153.                         rgb.red := redP[lcc]*101H;
  154.                         rgb.green := greenP[lcc]*101H;
  155.                         rgb.blue := blueP[lcc]*101H;
  156.                         RGBForeColor (rgb)
  157.                     ELSE
  158.                         Sys.PmForeColor(lcc+2)
  159.                     END;
  160.                     tpc := lcc
  161.                 END;
  162.                 IF thePort.txMode # lco THEN Sys.TextMode(lco) END;
  163.                 IF tpf # lcf THEN Sys.TextFont(fnt.fntNum); Sys.TextFace(fnt.fntFace); Sys.TextSize(fnt.fntSize); tpf := lcf END
  164.             ELSE
  165.                 IF QD.thePort # shadowPortPtr THEN Sys.SetPort(shadowPort) END;
  166.                 IF shadowPort.clipRgn # lck THEN Sys.SetClip(lck) END;
  167.                 IF spc # lcc THEN Sys.ForeColor(shadowColor[lcc]); spc := lcc END;
  168.                 IF shadowPort.txMode # lco THEN Sys.TextMode(lco) END;
  169.                 IF spf # lcf THEN Sys.TextFont(fnt.fntNum); Sys.TextFace(fnt.fntFace); Sys.TextSize(fnt.fntSize); spf := lcf END
  170.             END;
  171.             Sys.MoveTo(lcx0, lcy+fnt.ndescent); Sys.DrawText(lineBuf, 0, llen); llen := 0
  172.         END
  173.     END FlushCache;
  174.     PROCEDURE SetPenPort* (port: Sys.GrafPtr);
  175.         VAR p: Sys.GrafRealPtr;
  176.     BEGIN FlushCache; 
  177.         p := SYS.VAL (Sys.GrafRealPtr, port);
  178.         Sys.SetPort(p^); ppf := 0
  179.     END SetPenPort;
  180.     PROCEDURE SetPenPic* (port: Sys.GrafPtr; black: BOOLEAN; mode: INTEGER);
  181.         VAR p: Sys.GrafRealPtr;
  182.     BEGIN FlushCache; ppf := 0; p := SYS.VAL (Sys.GrafRealPtr, port);
  183.         IF QD.thePort # port THEN Sys.SetPort(p^) END;
  184.         IF black THEN Sys.ForeColor(whiteColor) ELSE Sys.ForeColor(blackColor) END;
  185.         IF p.pnMode # mode THEN Sys.PenMode(mode) END
  186.     END SetPenPic;
  187.     PROCEDURE SetPenScreen* (main: BOOLEAN; clip: Sys.RgnHandle; col, mode: INTEGER);
  188.     VAR rgb: Sys.RGBColor;
  189.     BEGIN
  190.         FlushCache;
  191.         IF main THEN
  192.             IF SYS.VAL (LONGINT, QD.thePort) # SYS.VAL (LONGINT, thePortPtr) THEN Sys.SetPort(thePort) END;
  193.             IF thePort.clipRgn # clip THEN Sys.SetClip(clip) END;
  194.             IF tpc # col THEN
  195.                 IF trueColor THEN
  196.                     rgb.red := redP[col]*101H;
  197.                     rgb.green := greenP[col]*101H;
  198.                     rgb.blue := blueP[col]*101H;
  199.                     RGBForeColor (rgb)
  200.                 ELSE
  201.                     Sys.PmForeColor(col+2)
  202.                 END;
  203.                 tpc := col
  204.             END;
  205.             IF thePort.pnMode # mode THEN Sys.PenMode(mode) END
  206.         ELSE
  207.             IF QD.thePort # shadowPortPtr THEN Sys.SetPort(shadowPort) END;
  208.             IF shadowPort.clipRgn # clip THEN Sys.SetClip(clip) END;
  209.             IF spc # col THEN Sys.ForeColor(shadowColor[col]); spc := col END;
  210.             IF shadowPort.pnMode # mode THEN Sys.PenMode(mode) END
  211.         END
  212.     END SetPenScreen;
  213.     PROCEDURE CopyPattern* (pat: LONGINT; x, y: INTEGER);
  214.         VAR p: Sys.BitMapRealPtr; r: Sys.Rect; port: Sys.GrafRealPtr;
  215.     BEGIN
  216.         port := SYS.VAL (Sys.GrafRealPtr, QD.thePort);
  217.         IF ODD(pat) THEN
  218.             IF port.txMode # port.pnMode THEN Sys.TextMode(port.pnMode) END;
  219.             Sys.TextFont(SHORT((pat DIV 1000000H) MOD 100H));
  220.             Sys.TextFace(SHORT((pat DIV 2) MOD 4));
  221.             Sys.TextSize(SHORT((pat DIV 10000H) MOD 100H));
  222.             tpf := 0; spf := 0;
  223.             Sys.MoveTo(x, y+(SHORT(SHORT(pat)) DIV 8));
  224.             Sys.DrawChar(SHORT((pat DIV 100H) MOD 100H))
  225.         ELSIF pat # 0 THEN
  226.             p := SYS.VAL(Sys.BitMapRealPtr, pat);
  227.             r.bottom := y; r.left := x; r.top := r.bottom-p.bounds.bottom; r.right := r.left+p.bounds.right;
  228.             Sys.PenPat(QD.black);
  229.             Sys.CopyBits(p^, port.portBits, p.bounds, r, port.pnMode, 0)
  230.         END
  231.     END CopyPattern;
  232.     PROCEDURE CopyPatternScreen* (main: BOOLEAN; clip: Sys.RgnHandle; col: INTEGER; pat: LONGINT; x, y, mode: INTEGER);
  233.     BEGIN
  234.         IF pat = SYS.VAL(LONGINT, ccp) THEN
  235.             IF (x = lcx) & (y = lcy) & (ccf = lcf) & (col = lcc) & (mode = lco) 
  236.             & (llen # 0) & (llen # LineLen) & (clip=lck) & (main=lcm) THEN
  237.                 line[llen] := ccp[2]; INC(llen); INC(lcx, ccdx); RETURN
  238.             ELSE
  239.                 FlushCache;
  240.                 line[0] := ccp[2]; llen := 1;
  241.                 lcx0 := x; lcx := lcx0+ccdx; lcy := y; lcf := ccf; lcc := col; lco := mode; lck := clip; lcm := main;
  242.                 RETURN
  243.             END
  244.         ELSE SetPenScreen(main, clip, col, mode); CopyPattern(pat, x, y)
  245.         END
  246.     END CopyPatternScreen;
  247.     PROCEDURE CopyBlock* (sP, dP: Sys.GrafPtr; sx, sy, sw, sh, dx, dy, dw, dh: INTEGER);
  248.         VAR sr, dr: Sys.Rect;sPr, dPr, port : Sys.GrafRealPtr;
  249.     BEGIN
  250.         sr.bottom := sy; sr.left := sx; sr.top := sr.bottom-sh; sr.right := sr.left+sw;
  251.         dr.bottom := dy; dr.left := dx; dr.top := dr.bottom-dh; dr.right := dr.left+dw;
  252.         sPr := SYS.VAL (Sys.GrafRealPtr, sP);
  253.         dPr := SYS.VAL (Sys.GrafRealPtr, dP);
  254.         port := SYS.VAL (Sys.GrafRealPtr, QD.thePort);
  255.         Sys.PenPat(QD.black);
  256.         Sys.CopyBits(sPr.portBits, dPr.portBits, sr, dr, port.pnMode, 0)
  257.     END CopyBlock;
  258.     PROCEDURE ReplPattern* (pat: LONGINT; x, y, w, h: INTEGER);
  259.         VAR p: PatMapPtr; r: Sys.Rect;
  260.     BEGIN
  261.         IF (pat # 0) & ~ODD(pat) THEN p := SYS.VAL(PatMapPtr, pat);
  262.             r.bottom := y; r.left := x; r.top := r.bottom-h; r.right := r.left+w; Sys.PenPat(p.pattern); Sys.PaintRect(r)
  263.         END
  264.     END ReplPattern;
  265.     PROCEDURE FillPattern* (pat: LONGINT; px, py, x, y, w, h: INTEGER);
  266.         VAR p: PatMapPtr; r: Sys.Rect;
  267.     BEGIN
  268.         IF (pat # 0) & ~ODD(pat) THEN p := SYS.VAL(PatMapPtr, pat);
  269.             r.bottom := y; r.left := x; r.top := r.bottom-h; r.right := r.left+w; Sys.PenPat(p.pattern); Sys.PaintRect(r)
  270.         END
  271.     END FillPattern;
  272.     PROCEDURE ReplConst* (x, y, w, h: INTEGER);
  273.         VAR r: Sys.Rect;
  274.     BEGIN r.bottom := y; r.left := x; r.top := r.bottom-h; r.right := r.left+w; Sys.PenPat(QD.black); Sys.PaintRect(r)
  275.     END ReplConst;
  276.     PROCEDURE Dot* (x, y: INTEGER);
  277.     BEGIN Sys.PenPat(QD.black); Sys.MoveTo(x, y); Sys.Lin(0, 0)
  278.     END Dot;
  279.     PROCEDURE Line* (x0, y0, x1, y1: INTEGER);
  280.     BEGIN Sys.PenPat(QD.black); Sys.MoveTo(x0, y0); Sys.LineTo(x1, y1)
  281.     END Line;
  282.     PROCEDURE Circle* (x, y, r: INTEGER);
  283.         VAR rec: Sys.Rect;
  284.     BEGIN rec.bottom := y+r; rec.top := rec.bottom-2*r-1; rec.left := x-r; rec.right := x+r+1; Sys.PenPat(QD.black); Sys.FrameOval(rec)
  285.     END Circle;
  286.     PROCEDURE Ellipse* (x, y, a, b: INTEGER);
  287.         VAR rec: Sys.Rect;
  288.     BEGIN rec.bottom := y+b; rec.top := rec.bottom-2*b-1; rec.left := x-a; rec.right := x+a+1; Sys.PenPat(QD.black); Sys.FrameOval(rec)
  289.     END Ellipse;
  290.     PROCEDURE ContString* (f: FontMapPtr; VAR s: ARRAY OF CHAR);
  291.         VAR len: INTEGER; port: Sys.GrafRealPtr; fnt: FontMapRealPtr;
  292.     BEGIN len := 0; port := SYS.VAL (Sys.GrafRealPtr, QD.thePort); fnt:=SYS.VAL (FontMapRealPtr, f);
  293.         WHILE s[len] # 0X DO INC(len) END;
  294.         IF port.txMode # port.pnMode THEN Sys.TextMode(port.pnMode) END;
  295.         IF f # ppf THEN Sys.TextFont(fnt.fntNum); Sys.TextFace(fnt.fntFace); Sys.TextSize(fnt.fntSize); ppf := f END;
  296.         Sys.DrawText(SYS.ADR(s), 0, len)
  297.     END ContString;
  298.     PROCEDURE String* (f: FontMapPtr; x, y: INTEGER; VAR s: ARRAY OF CHAR);
  299.         VAR fnt: FontMapRealPtr;
  300.     BEGIN fnt:=SYS.VAL (FontMapRealPtr, f); Sys.MoveTo(x, y+fnt.ndescent); ContString(f, s)
  301.     END String;
  302. (* Colors *)
  303.     PROCEDURE EnterColor (col, red, green, blue: INTEGER);
  304.     BEGIN redP[col] := red; greenP[col] := green; blueP[col] := blue
  305.     END EnterColor;
  306.     PROCEDURE SetColor* (col, red, green, blue: INTEGER);
  307.         VAR rgb: Sys.RGBColor;
  308.     BEGIN
  309.         IF (col > 3) & (col # 15) THEN EnterColor(col, red, green, blue) END;
  310.         rgb.red := red*101H; rgb.green := green*101H; rgb.blue := blue*101H;
  311.         Sys.AnimateEntry(thePortPtr, col+2, rgb)
  312.     END SetColor;
  313.     PROCEDURE GetColor* (col: INTEGER; VAR red, green, blue: INTEGER);
  314.     BEGIN red := redP[col]; green := greenP[col]; blue := blueP[col]
  315.     END GetColor;
  316.     PROCEDURE SetUserClip* (x, y, w, h: INTEGER);
  317.     BEGIN FlushCache; Sys.SetRectRgn(userClip, x, y-h, x+w, y)
  318.     END SetUserClip;
  319. (* Pictures *)
  320.     PROCEDURE Open* (P: Sys.GrafPtr; width, height: INTEGER);
  321.         VAR port: Sys.GrafRealPtr;
  322.     BEGIN port := SYS.VAL (Sys.GrafRealPtr, P);
  323.         Sys.OpenPort(port^); port.portBits.rowBytes := ((width+31) DIV 32)*4;
  324.         Sys.AllocBlock(port.portBits.baseAddr, LONG(port.portBits.rowBytes)*LONG(height));
  325.         port.portBits.bounds.top := 0; port.portBits.bounds.bottom := height; port.portBits.bounds.left := 0;  
  326.         port.portBits.bounds.right := width;
  327.         port.portRect := port.portBits.bounds; Sys.RectRgn(port.visRgn, port.portBits.bounds)
  328.     END Open;
  329.     PROCEDURE Close* (P: Sys.GrafPtr);
  330.         VAR port: Sys.GrafRealPtr;
  331.     BEGIN port := SYS.VAL (Sys.GrafRealPtr, P);
  332.         Sys.DeAllocBlock(port.portBits.baseAddr); port.portBits.baseAddr := 0
  333.     END Close;
  334. (* Patterns *)
  335.     PROCEDURE NewPatMap* (VAR image: ARRAY OF SET; width, height, offset: INTEGER): PatMapPtr;
  336.         VAR p: PatMapPtr; row, byte: INTEGER; src, dest, data: LONGINT; pat: Longword;
  337.     BEGIN NEW(p); p.bounds.bottom := height; p.bounds.right := width;
  338.         p.rowBytes := ((width+31) DIV 32)*4; Sys.AllocBlock(p.baseAddr, p.rowBytes*height); p.link := patMaps; patMaps := p;
  339.         src := SYS.ADR(image[offset]); dest := p.baseAddr+p.rowBytes* (height-1);
  340.         FOR row := 0 TO height-1 DO
  341.             FOR byte := 0 TO p.rowBytes-1 BY 4 DO
  342.                 SYS.GET(src, data); pat := SYS.VAL(Longword, data); INC(src, 4);
  343.                 SYS.PUT(dest, inverse[ORD(pat[3])]); INC(dest); SYS.PUT(dest, inverse[ORD(pat[2])]); INC(dest);
  344.                 SYS.PUT(dest, inverse[ORD(pat[1])]); INC(dest); SYS.PUT(dest, inverse[ORD(pat[0])]); INC(dest)
  345.             END;
  346.             dest := dest-2*p.rowBytes
  347.         END;
  348.         dest := SYS.ADR(p.pattern)+7;
  349.         FOR row := 0 TO 7 DO
  350.             src := SYS.ADR(image[offset])+p.rowBytes* ((thePortH+row) MOD height);
  351.             SYS.GET(src, data); pat := SYS.VAL(Longword, data); SYS.PUT(dest, inverse[ORD(pat[3])]); DEC(dest)
  352.         END;
  353.         RETURN p
  354.     END NewPatMap;
  355.     PROCEDURE GetPatSize* (pat: LONGINT; VAR w, h: INTEGER);
  356.         VAR p: PatMapPtr; fontInfo: Sys.FontInfo;
  357.     BEGIN
  358.         IF ODD(pat) THEN FlushCache;
  359.             IF QD.thePort # shadowPortPtr THEN Sys.SetPort(shadowPort) END;
  360.             Sys.TextFont(SHORT((pat DIV 1000000H) MOD 100H)); Sys.TextFace(SHORT((pat DIV 2) MOD 4));
  361.             Sys.TextSize(SHORT((pat DIV 10000H) MOD 100H)); spf := 0;
  362.             Sys.GetFontInf(fontInfo); h := fontInfo.ascent+fontInfo.descent; w := Sys.CharWidth(SHORT((pat DIV 100H) MOD 100H))
  363.         ELSE p := SYS.VAL(PatMapPtr, pat); w := p.bounds.right; h := p.bounds.bottom
  364.         END
  365.     END GetPatSize;
  366. (* Fonts *)
  367.     PROCEDURE GetFontInfo* (VAR fname: ARRAY OF CHAR; VAR fntNum, fntSize, fntFace: INTEGER);
  368.         VAR i: INTEGER; ch, styl: CHAR; str: Sys.Str255;
  369.     BEGIN i := 0; ch := fname[0];
  370.         WHILE (ch # ".") & (ch # 0X) & ((ch < "0") OR (ch > "9")) & (i < 24) DO INC(i); str[i] := ch; ch := fname[i] END;
  371.         IF i = 0 THEN fntNum := 0
  372.         ELSE str[0] := CHR(i); Sys.GetFNum(str, fntNum);
  373.             IF fntNum=osyntaxFnt THEN fntNum := syntaxFnt END;
  374.             fntSize := 0;
  375.             WHILE (fname[i] >= "0") & (fname[i] <= "9") & (i < 24) DO fntSize := 10 * fntSize + ORD(fname[i]) - ORD("0"); INC(i) END;
  376.             IF fntSize = 0 THEN fntSize := 24 END;
  377.             styl := CAP(fname[i]);
  378.             IF styl="B" THEN fntFace := 1
  379.             ELSIF styl="I" THEN fntFace := 2
  380.             ELSIF styl="M" THEN fntFace := 3
  381.             ELSE fntFace := 0
  382.             END;
  383.         END
  384.     END GetFontInfo;
  385.     PROCEDURE GetFontName* (fntNum, fntSize, fntFace: INTEGER; VAR fname: ARRAY OF CHAR);
  386.         VAR ch: CHAR; str: Sys.Str255; i, k, m: INTEGER;
  387.     BEGIN
  388.         IF fntSize = 0 THEN COPY(defaultFontName, fname)
  389.         ELSE
  390.             IF fntNum = syntaxFnt THEN fntNum := osyntaxFnt END;
  391.             Sys.GetFontNam(fntNum, str);
  392.             i := ORD(str[0]);
  393.             WHILE i > 0 DO ch := str[i]; DEC(i); fname[i] := ch END;
  394.             i := ORD(str[0]);
  395.             IF fntSize > 1 THEN m := 1;
  396.                 WHILE m  <=  fntSize DO m := m*10 END;
  397.                 WHILE m > 1 DO m := m DIV 10; k := fntSize DIV m; fname[i] := CHR(k+ORD("0")); INC(i); DEC(fntSize, k*m) END
  398.             END;
  399.             IF fntFace = 1 THEN fname[i] := "b"; INC(i)
  400.             ELSIF fntFace = 2 THEN fname[i] := "i"; INC(i)
  401.             ELSIF fntFace = 3 THEN fname[i] := "m"; INC(i)
  402.             END;
  403.             fname[i] := "."; INC(i); fname[i] := "S"; INC(i); fname[i] := "c"; INC(i); fname[i] := "n"; INC(i);
  404.             fname[i] := "."; INC(i); fname[i] := "F"; INC(i); fname[i] := "n"; INC(i); fname[i] := "t"; INC(i); fname[i] := 0X
  405.         END
  406.     END GetFontName;
  407.     PROCEDURE NewFontMap* (fntNum, fntSize, fntFace: INTEGER): FontMapPtr;
  408.         VAR map: FontMapRealPtr; i: INTEGER; fontInfo: Sys.FontInfo;
  409.     BEGIN FlushCache;
  410.         IF QD.thePort # shadowPortPtr THEN Sys.SetPort(shadowPort) END;
  411.         Sys.TextFont(fntNum); Sys.TextSize(fntSize); Sys.TextFace(fntFace); spf := 0; Sys.GetFontInf(fontInfo); NEW(map);
  412.         map.fntNum := fntNum; map.fntSize := fntSize; map.fntFace := fntFace;
  413.         map.height := fontInfo.ascent + fontInfo.descent; map.widMax := fontInfo.widMax;
  414.         map.ascent := fontInfo.ascent; map.ndescent := - fontInfo.descent;
  415.         map.fCode := (fntNum MOD 100H) * 1000000H + (fntSize MOD 100H) * 10000H
  416.             + ((-fontInfo.descent) * 2*4) MOD 100H + (fntFace MOD 4) * 2 + 1;
  417.         FOR i := 0 TO 255 DO map.width[i] := Sys.CharWidth(i) END;
  418.         RETURN SYS.VAL (FontMapPtr, map)
  419.     END NewFontMap;
  420.     PROCEDURE ConvertChar (VAR ch: CHAR);        (* convert Oberon umlauts to Macintosh *)
  421.     BEGIN
  422.         CASE ORD(ch) OF
  423.             131:    ch := CHR (138)
  424.         |    132:    ch := CHR (154)
  425.         |    133:    ch := CHR (159)
  426. (*     |    128:    ch := CHR (128) *)
  427.         |    129:    ch := CHR (133)
  428.         |    130:    ch := CHR (134)
  429.         ELSE
  430.         END 
  431.     END ConvertChar;
  432.     PROCEDURE GetChar* (f: LONGINT; ch: CHAR; VAR dx, x, y, w, h: INTEGER; VAR p: LONGINT);
  433.         VAR i: INTEGER; fnt: FontMapRealPtr;
  434.     BEGIN
  435.         fnt:=SYS.VAL (FontMapRealPtr, f);
  436.         IF (ORD (ch) >= 128) & ((~bitmapSyntax) OR (fnt.fntNum#syntaxFnt)) THEN ConvertChar (ch) END;
  437.         SYS.GET(f, SYS.VAL(LONGINT, ccp)); ccp[2] := ch; p := SYS.VAL(LONGINT, ccp);
  438.         ccf := SYS.VAL(FontMapPtr, f); SYS.GET(f + 4 + ORD(ch) * 2, i);
  439.         IF i = 0 THEN h := 0 ELSE h := fnt.height END;
  440.         w := i; dx := i; ccdx := i; x := 0; y := fnt.ndescent
  441.     END GetChar;
  442. (* Splines *)
  443.     PROCEDURE SolveTriDiag (VAR a, b, c, y: RealVector; n: INTEGER);
  444.         VAR i: INTEGER;
  445.     BEGIN i := 1; (*a, b, c of tri-diag matrix T; solve Ty'=y for y', assign y' to y*)
  446.         WHILE i < n DO y[i] := y[i]-c[i-1]*y[i-1]; INC(i) END;
  447.         i := n-1; y[i] := y[i]/a[i];
  448.         WHILE i > 0 DO DEC(i); y[i] := (y[i]-b[i]*y[i+1])/a[i] END
  449.     END SolveTriDiag;
  450.     PROCEDURE OpenSpline* (VAR x, y, d: RealVector; n: INTEGER);
  451.         VAR i: INTEGER; d1, d2: REAL; a, b, c: RealVector;
  452.     BEGIN b[0] := 1.0/(x[1]-x[0]); a[0] := 2.0*b[0]; c[0] := b[0]; d1 := (y[1]-y[0])*3.0*b[0]*b[0]; d[0] := d1; i := 1; (*from x, y compute d=y'*)
  453.         WHILE i < n-1 DO
  454.             b[i] := 1.0/(x[i+1]-x[i]); a[i] := 2.0* (c[i-1]+b[i]); c[i] := b[i];
  455.             d2 := (y[i+1]-y[i])*3.0*b[i]*b[i]; d[i] := d1+d2; d1 := d2; INC(i)
  456.         END;
  457.         a[i] := 2.0*b[i-1]; d[i] := d1; i := 0;
  458.         WHILE i < n-1 DO c[i] := c[i]/a[i]; a[i+1] := a[i+1]-c[i]*b[i]; INC(i) END;
  459.         SolveTriDiag(a, b, c, d, n)
  460.     END OpenSpline;
  461.     PROCEDURE ClosedSpline* (VAR x, y, d: RealVector; n: INTEGER);
  462.         VAR i: INTEGER; d1, d2, hn, dn: REAL; a, b, c, w: RealVector;
  463.     BEGIN hn := 1.0/(x[n-1]-x[n-2]); dn := (y[n-1]-y[n-2])*3.0*hn*hn; (*from x, y compute d=y'*)
  464.         b[0] := 1.0/(x[1]-x[0]); a[0] := 2.0*b[0]+hn; c[0] := b[0]; d1 := (y[1]-y[0])*3.0*b[0]*b[0]; d[0] := dn+d1; w[0] := 1.0; i := 1;
  465.         WHILE i < n-2 DO
  466.             b[i] := 1.0/(x[i+1]-x[i]); a[i] := 2.0* (c[i-1]+b[i]); c[i] := b[i];
  467.             d2 := (y[i+1]-y[i])*3.0*b[i]*b[i]; d[i] := d1+d2; d1 := d2; w[i] := 0; INC(i)
  468.         END ;
  469.         a[i] := 2.0*b[i-1]+hn; d[i] := d1+dn; w[i] := 1.0; i := 0;
  470.         WHILE i < n-2 DO c[i] := c[i]/a[i]; a[i+1] := a[i+1]-c[i]*b[i]; INC(i) END;
  471.         SolveTriDiag(a, b, c, d, n-1); SolveTriDiag(a, b, c, w, n-1); 
  472.         d1 := (d[0]+d[i])/(w[0]+w[i]+x[i+1]-x[i]); i := 0;
  473.         WHILE i < n-1 DO d[i] := d[i]-d1*w[i]; INC(i) END;
  474.         d[i] := d[0]
  475.     END ClosedSpline;
  476. (* Clipboard *)
  477.     PROCEDURE GetScrap*;
  478.     VAR h : Sys.TERealHandle;
  479.     BEGIN h := SYS.VAL (Sys.TERealHandle, scrap);
  480.         Sys.TEStylPaste(scrap); style := Sys.TEGetStylHandle(scrap); max := h.p.teLength;
  481.         textHandle := h.p.teHandle; Sys.HLock(textHandle); SYS.GET(textHandle, text); pos := 0
  482.     END GetScrap;
  483.     PROCEDURE GetRun* (VAR run: ARRAY OF CHAR; VAR len: INTEGER; VAR fname: ARRAY OF CHAR);
  484.         VAR l, f, rn, end: INTEGER; txStyl: Sys.TextStyle; s: Sys.TEStyleRealHandle; h : Sys.TERealHandle;
  485.     BEGIN
  486.         s := SYS.VAL (Sys.TEStyleRealHandle, style);
  487.         h := SYS.VAL (Sys.TERealHandle, scrap);
  488.         IF pos < max THEN
  489.             IF s # NIL THEN
  490.                 Sys.TEGetStyle(pos, txStyl, l, f, scrap);
  491.                 GetFontName(txStyl.tsFont, txStyl.tsSize, txStyl.tsFace DIV 100H, fname);
  492.                 rn := 0;
  493.                 WHILE s.p.runs[rn].startChar  <=  pos DO INC(rn) END;
  494.                 end := s.p.runs[rn].startChar;
  495.                 IF end > max THEN end  :=  max END
  496.             ELSE COPY(defaultFontName, fname); end := h.p.teLength
  497.             END;
  498.             len := end-pos;
  499.             IF len > LEN(run) THEN len := SHORT(LEN(run)) END;
  500.             SYS.MOVE(text+pos, SYS.ADR(run), len);
  501.             INC(pos, len)
  502.         ELSE len := 0; Sys.HUnlock(textHandle); Sys.TESetSelect(0, h.p.teLength, scrap); Sys.TEDelete(scrap)
  503.         END
  504.     END GetRun;
  505.     PROCEDURE PutRun* (VAR run: ARRAY OF CHAR; len: INTEGER; VAR fname: ARRAY OF CHAR);
  506.         VAR txStyl: Sys.TextStyle; h : Sys.TERealHandle;
  507.     BEGIN h := SYS.VAL (Sys.TERealHandle, scrap);
  508.         GetFontInfo(fname, txStyl.tsFont, txStyl.tsSize, txStyl.tsFace);
  509.         Sys.TESetSelect(h.p.teLength, h.p.teLength, scrap); Sys.TEInsert(SYS.ADR(run), len, scrap);
  510.         Sys.TESetSelect(h.p.teLength-len, h.p.teLength, scrap); Sys.TESetStyle(7, txStyl, TRUE, scrap)
  511.     END PutRun;
  512.     PROCEDURE PutScrap*;
  513.         VAR h : Sys.TERealHandle;
  514.     BEGIN h := SYS.VAL (Sys.TERealHandle, scrap); Sys.TESetSelect(0, h.p.teLength, scrap); Sys.TECut(scrap)
  515.     END PutScrap;
  516. (* Environment *)
  517.     PROCEDURE AboutOberon*;
  518.         VAR itemHit: INTEGER;
  519.     BEGIN  itemHit := Sys.Alert(32767, 0)
  520.     END AboutOberon;
  521.     PROCEDURE GetPar* (parName: ARRAY OF CHAR; VAR thePar: ARRAY OF CHAR);
  522.         VAR resName: Sys.Str255; resHandle: LONGINT; resPtr: POINTER TO ARRAY 256 OF CHAR;
  523.     BEGIN
  524.         SetStr255(resName, parName);
  525.         resHandle := Sys.GetNamedResource(Sys.ApplSig, resName);
  526.         IF resHandle = 0 THEN thePar[0] := 0X
  527.         ELSE Sys.HLock(resHandle); SYS.GET(resHandle, resPtr); COPY(resPtr^, thePar); Sys.HUnlock(resHandle)
  528.         END
  529.     END GetPar;
  530. (* Events *)
  531.     PROCEDURE MenuCommand (menuResult: MenuEventMsg);
  532.         VAR res: INTEGER; daName: Sys.Str255;
  533.     BEGIN
  534.         IF menuResult.id # noMenu THEN
  535.             Sys.GetItem(Sys.GetMHandle(menuResult.id), menuResult.item, daName);
  536.             GetStr255(daName, cmdName);  cmdQ.Handle(); 
  537.             IF qRes # 0 THEN res := Sys.OpenDeskAcc(daName) END;
  538.             Sys.HiliteMenu(noMenu)
  539.         END
  540.     END MenuCommand;
  541.     PROCEDURE BufferKey (msg: KeyEventMsg; cntrlKeyDown: BOOLEAN);
  542.     BEGIN
  543.         IF cntrlKeyDown  &  (msg.ascii < 20X) THEN
  544.             keybuf[nofch] := msg.ascii
  545.         ELSIF msg.ascii=10X THEN
  546.             CASE msg.virtual OF
  547.             | 7AX: keybuf[nofch] := 0F1X (* F1 *)
  548.             | 78X: keybuf[nofch] := 0F2X (* F2 *)
  549.             | 63X: keybuf[nofch] := 0F3X (* F3 *)
  550.             | 76X: keybuf[nofch] := 0F4X (* F4 *)
  551.             ELSE END
  552.         ELSIF msg.ascii=1BX THEN
  553.             IF msg.virtual=47X THEN keybuf[nofch] := 0AX ELSE keybuf[nofch] := 1BX END (*ESC, NumLock => LF *)
  554.         ELSIF msg.ascii=7FX THEN
  555.             IF msg.virtual=75X THEN keybuf[nofch] := 08X ELSE keybuf[nofch] := 7FX END (*DEL, del right => BS *)
  556.         ELSE keybuf[nofch] := keytrans[ORD(msg.ascii)]
  557.         END;
  558.         INC(nofch)
  559.     END BufferKey;
  560.     PROCEDURE ScanEvents; (* Get all pending Keyboard Events / Handle non-Oberon Macintosh Events *)
  561.         CONST sleepTicks=0;
  562.             inDesk=0; inMenuBar=1; inSysWindow=2; inContent=3; inDrag=4; inGoAway=6; inZoomIn=7; inZoomOut=8;
  563.             nullEvent=0; mouseDown=1; mouseUp=2; keyDown=3; keyUp=4; autoKey=5; updateEvt=6;
  564.             diskEvt=7; activateEvt=8; networkEvt=10; app3Evt=14; osEvt=15; everyEvent=-1;
  565.         VAR gotEvent: BOOLEAN; event: Sys.EventRecord; eventWindow: Sys.WindowPtr; m:MenuEventMsg;
  566.     BEGIN
  567.         nofch := 0; nextch := 0; macEvent := FALSE;
  568.         LOOP
  569.             Sys.SetCurs(obnArrow);
  570.             gotEvent := Sys.WaitNextEvent(everyEvent, event, 0, 0);
  571.             CASE event.what OF
  572.             | mouseDown: 
  573.                 macEvent := TRUE;
  574.                 CASE Sys.FindWindow(SYS.VAL(LONGINT, event.where), eventWindow) OF
  575.                 | inDesk, inZoomIn, inZoomOut:
  576.                 | inMenuBar: m := SYS.VAL(MenuEventMsg, Sys.MenuSelect(SYS.VAL(LONGINT, event.where))); MenuCommand(m)
  577.                 | inSysWindow: Sys.SystemClick(event, eventWindow)
  578.                 | inContent: Sys.SelectWindow1(eventWindow)
  579.                 | inDrag: Sys.DragWindow(eventWindow, SYS.VAL(LONGINT, event.where), grafArea)
  580.                 | inGoAway: IF eventWindow=thePortPtr THEN HideOberonWindow ELSE Sys.CloseWindow(thePortPtr) END
  581.                 END
  582.             | keyDown:
  583.                 IF Sys.FrontWindow()=thePortPtr THEN
  584.                     IF 23 IN SYS.VAL(SET, LONG(event.modifiers)) THEN
  585.                         m := SYS.VAL(MenuEventMsg, Sys.MenuKey(SHORT(event.message MOD 100H)));
  586.                         MenuCommand (m);
  587.                     ELSE BufferKey(SYS.VAL(KeyEventMsg, event.message), ODD(event.modifiers DIV 4096));
  588.                         RETURN
  589.                     END
  590.                 END
  591.             | autoKey:
  592.                 IF Sys.FrontWindow()=thePortPtr THEN
  593.                     BufferKey(SYS.VAL(KeyEventMsg, event.message), ODD(event.modifiers DIV 4096));
  594.                     RETURN
  595.                 END
  596.             | updateEvt:
  597.                 IF SYS.VAL(Sys.WindowPtr, event.message)=thePortPtr THEN UpdateOberonWindow
  598.                 ELSE Sys.BeginUpdate1(event.message); Sys.EndUpdate1(event.message)
  599.                 END
  600.             | activateEvt:
  601.                 IF (SYS.VAL(Sys.WindowPtr, event.message)=thePortPtr)  &  ODD(event.modifiers) THEN Sys.SetPort(thePort) END;
  602.             | osEvt:
  603.                 macEvent := TRUE;
  604.                 IF ~ODD(event.message) THEN
  605.                     convertClip:=ODD(event.message DIV 2);
  606.                     suspendQ.Handle();
  607.                     LOOP gotEvent := Sys.WaitNextEvent(everyEvent, event, 0, 0);
  608.                         IF event.what=updateEvt THEN
  609.                             IF SYS.VAL(Sys.WindowPtr, event.message)=thePortPtr THEN UpdateOberonWindow
  610.                             ELSE Sys.BeginUpdate1(event.message); Sys.EndUpdate1(event.message)
  611.                             END
  612.                         ELSIF (event.what=osEvt)  &  ODD(event.message) THEN EXIT
  613.                         ELSE backgroundQ.Handle()
  614.                         END
  615.                     END;
  616.                     convertClip:=ODD(event.message DIV 2); resumeQ.Handle(); Sys.HiliteMenu(noMenu)
  617.                 END
  618.             | nullEvent, mouseUp, keyUp, diskEvt, networkEvt..app3Evt: RETURN
  619.             ELSE RETURN
  620.             END
  621.         END
  622.     END ScanEvents;
  623.     PROCEDURE Available* (): INTEGER;
  624.     BEGIN IF nextch < nofch THEN RETURN nofch-nextch ELSE ScanEvents; RETURN nofch END
  625.     END Available;
  626.     PROCEDURE Read* (VAR ch: CHAR);
  627.     BEGIN REPEAT UNTIL Available() > 0; ch := keybuf[nextch]; INC(nextch)
  628.     END Read;
  629.     PROCEDURE Mouse* (VAR keys: SET; VAR x, y: INTEGER); (* Mouse Coordinates local to Display Window *)
  630.         VAR p: Sys.Point; map: Sys.KeyMap;
  631.     BEGIN FlushCache;
  632.         IF SYS.VAL (LONGINT, QD.thePort) # SYS.VAL (LONGINT, thePortPtr) THEN Sys.SetPort(thePort) END;
  633.         Sys.GetMouse(p);
  634.         IF p.h  <= 0 THEN x := 0 ELSIF p.h > xlim THEN x := xlim ELSE x := p.h END;
  635.         IF p.v  <= 0 THEN y := ylim ELSIF p.v > ylim THEN y := 0 ELSE y := ylim-p.v END;
  636.         Sys.GetKeys(map);
  637.         IF 28 IN map[1] THEN keys := {1} ELSE keys := {} END; (* Control Key Down *)
  638.         IF 29 IN map[1] THEN INCL(keys, 0) END; (* Option Key Down *)
  639.         IF Sys.Button() THEN INCL(keys, 2) END (* Mouse Button Pressed *)
  640.     END Mouse;
  641.     PROCEDURE SetMouseLimits* (w, h: INTEGER);
  642.     BEGIN xlim := w-1; ylim := h-1
  643.     END SetMouseLimits;
  644. (* keyboard interrupt *)
  645. PROCEDURE Suspended;
  646. BEGIN suspended:=TRUE END Suspended;
  647. PROCEDURE Resumed;
  648. BEGIN suspended:=FALSE END Resumed;
  649. PROCEDURE Retrace (t : LONGINT);
  650. VAR kmap : SET; pc, sp, sp1, sp2: LONGINT;
  651. BEGIN
  652.     vblTask.vblCount := 6;
  653.     IF ~suspended THEN
  654.         SYS.GET (178H, kmap);
  655.         IF kmap * {8, 16} = {8, 16} THEN
  656.             IF ~pressed THEN
  657.                 pressed := TRUE;
  658.                 SYS.GETREG (1, sp); SYS.GET (sp, sp); SYS.GET (sp, sp); sp := sp + 335;
  659.                 SYS.GET (sp, pc);
  660. (* sp1 := sp + 444; sp2 := sp + 440; SYS.GET (sp1, pc1); SYS.GET (sp2, pc2); IF pc1 = 0 THEN pc := pc2 ELSE pc := pc1 END; *)
  661.                 IF (pc > Kernel.heapBeg) & (pc < Kernel.heapEnd) THEN
  662.                     IF kbdIntPC # 0 THEN SYS.PUT (kbdIntPC, kbdIntInstr) END;
  663.                     kbdIntPC := pc;
  664.                     SYS.GET (pc, kbdIntInstr);
  665.                     SYS.PUT (pc, 7FE00008H)        (* patch with twi instruction *)
  666.                 END
  667.             END
  668.         ELSE pressed := FALSE
  669.         END 
  670.     END 
  671. END Retrace;
  672. (* Initialization *)
  673.     PROCEDURE InitBitTrans;
  674.         VAR i, bits, flip, r: LONGINT;
  675.     BEGIN i := 255;
  676.         WHILE i > 0 DO bits := i; flip := 0; r := 80H;
  677.             WHILE bits # 0 DO
  678.                 IF ODD(bits) THEN INC(flip, r) END;
  679.                 r := SYS.LSH(r,-1); bits := SYS.LSH(bits,-1)
  680.             END;
  681.             inverse[i] := CHR(flip); DEC(i)
  682.         END
  683.     END InitBitTrans;
  684.     PROCEDURE InitKeyTrans;
  685.         VAR i: INTEGER;
  686.     BEGIN
  687.         FOR i := 0 TO 255 DO keytrans[i] := CHR(i) END;
  688.         keytrans[3H] := 0A4X; (*Enter->SETUP*) keytrans[8H] := 7FX; (*BS -> DEL*);
  689.         keytrans[01H] := 091X; (*home -> NSCR*) keytrans[04H] := 093X; (*end -> SHNSCR*)
  690.         keytrans[0BH] := 0ACX; (*pgup -> BRK*) keytrans[0CH] := 0ADX; (*pgdown -> SHBRK*)
  691.         keytrans[1CH] := 0C4X; (*left*) keytrans[1DH] := 0C3X; (*right*)
  692.         keytrans[1EH] := 0C1X; (*up*) keytrans[1FH] := 0C2X; (*down*)
  693.         keytrans[80H] := 80X; (*Ae*) keytrans[85H] := 81X; (*Oe*) keytrans[86H] := 82X; (*Ue*)
  694.         keytrans[8AH] := 83X; (*ae*) keytrans[9AH] := 84X; (*oe*) keytrans[9FH] := 85X; (*ue*)
  695.         keytrans[89H] := 86X; (*a circonflex*) keytrans[90H] := 87X; (*e circonflex*) keytrans[94H] := 88X; (*i circonflex*)
  696.         keytrans[99H] := 89X; (*o circonflex*) keytrans[9EH] := 8AX; (*u circonflex*)
  697.         keytrans[88H] := 8BX; (*a grave*) keytrans[8FH] := 8CX; (*e grave*) keytrans[93H] := 8DX; (*i grave*)
  698.         keytrans[97H] := 8EX; (*o grave*) keytrans[9DH] := 8FX; (*u grave*)
  699.         keytrans[8EH] := 90X; (*e aigue*) keytrans[91H] := 91X; (*e dieresis*) keytrans[95H] := 92X; (*i dieresis*)
  700.         keytrans[8DH] := 93X; (*c cedille*) keytrans[87H] := 94X; (*a aigue*) keytrans[96H] := 95X; (*n tilde*)
  701.     END InitKeyTrans;
  702.     PROCEDURE InitMenuBar;
  703.     BEGIN
  704.         Sys.ClearMenuBar; obnMenus := Sys.GetNewMBar(32767);
  705.         Sys.AddResMenu(Sys.GetMenu(32767), 44525652H); Sys.SetMenuBar(obnMenus); Sys.DrawMenuBar;
  706.     END InitMenuBar;
  707.     PROCEDURE InitArrow;
  708.     BEGIN
  709.         obnArrow.data[0] := {17..24}; obnArrow.data[1] := {1..7, 17..22};
  710.         obnArrow.data[2] := {1..5, 17..22}; obnArrow.data[3] := {1..3, 5..7, 17..18, 22..24};
  711.         obnArrow.data[4] := {1, 7..9, 24..26}; obnArrow.data[5] := {9..11, 26..28};
  712.         obnArrow.data[6] := {11..13, 28..30}; obnArrow.data[7] := {13};
  713.         obnArrow.mask[0] := {0..9, 16..25}; obnArrow.mask[1] := {0..8, 16..23};
  714.         obnArrow.mask[2] := {0..6, 16..23}; obnArrow.mask[3] := {0..8, 16..19, 21..25};
  715.         obnArrow.mask[4] := {0..2, 6..10, 16..17, 23..27}; obnArrow.mask[5] := {8..12, 25..29};
  716.         obnArrow.mask[6] := {10..14, 27..31}; obnArrow.mask[7] := {12..14, 29}; 
  717. (*        obnArrow.data[0] := {7..14}; obnArrow.data[1] := {24..30, 9..14};
  718.         obnArrow.data[2] := {26..30, 9..14}; obnArrow.data[3] := {28..30, 24..26, 13..14, 7..9};
  719.         obnArrow.data[4] := {30, 22..24, 5..7}; obnArrow.data[5] := {20..22, 3..5};
  720.         obnArrow.data[6] := {18..20, 1..3}; obnArrow.data[7] := {18}; 
  721.         obnArrow.mask[0] := {22..31, 6..15}; obnArrow.mask[1] := {23..31, 8..15};
  722.         obnArrow.mask[2] := {25..31, 8..15}; obnArrow.mask[3] := {23..31, 12..15, 6..10};
  723.         obnArrow.mask[4] := {29..31, 21..25, 14..15, 4..8}; obnArrow.mask[5] := {19..23, 2..6};
  724.         obnArrow.mask[6] := {17..21, 0..4}; obnArrow.mask[7] := {17..19, 2}; *)
  725.         obnArrow.hotSpot.v := 1; obnArrow.hotSpot.h := 1
  726.     END InitArrow;
  727.     PROCEDURE InitWindow;
  728.         VAR bounds: Sys.Rect; titlStr: Sys.Str255; mBarH: INTEGER;
  729.     BEGIN
  730.         SetStr255(titlStr, "Oberon for PowerMac - University of Linz");
  731.         bounds := QD.screenBits.bounds;
  732.         mBarH := Sys.GetMBarHeight(); INC(bounds.top, mBarH);
  733.         thePortPtr := Sys.NewCWindow(thePort, bounds, titlStr, TRUE, 4, -1, FALSE, 4D534F46H);
  734.         thePortW := thePort.portRect.right-thePort.portRect.left;
  735.         thePortH := thePort.portRect.bottom-thePort.portRect.top;
  736.         Sys.OpenPort(shadowPort); 
  737.         shadowPortPtr := SYS.VAL(Sys.GrafPtr, SYS.ADR(shadowPort));
  738.         shadowPort.portBits.rowBytes := ((thePortW+31) DIV 32)*4;
  739.         IF thePortH < 1024 THEN shadowH := 1024 ELSE shadowH := thePortH END;
  740.         Sys.AllocBlock(shadowPort.portBits.baseAddr, LONG(shadowPort.portBits.rowBytes)*LONG(shadowH));
  741.         shadowPort.portBits.bounds.top := thePortH;
  742.         shadowPort.portBits.bounds.bottom := thePortH+shadowH;
  743.         shadowPort.portBits.bounds.left := 0;
  744.         shadowPort.portBits.bounds.right := thePortW;
  745.         shadowPort.portRect := shadowPort.portBits.bounds;
  746.         Sys.RectRgn(shadowPort.visRgn, shadowPort.portBits.bounds);
  747.         Sys.SetPort(thePort); Sys.BeginUpdate(thePort); Sys.EndUpdate(thePort);
  748.     END InitWindow;
  749.     PROCEDURE InitScrap;
  750.         VAR r: Sys.Rect;
  751.     BEGIN
  752.         r.top := 0; r.left := -thePortW; r.bottom := thePortH; r.right := 0;
  753.         scrap := Sys.TEStylNew(r, r)
  754.     END InitScrap;
  755.     PROCEDURE InitFontTrans;
  756.         VAR str: Sys.Str255; name: ARRAY 256 OF CHAR;
  757.     BEGIN 
  758.         GetPar("Fonts.DefaultFontName", defaultFontName);
  759.         GetPar("Macintosh.SyntaxFontName", name);
  760.         IF name = "automatic" THEN
  761.             IF thePortW < 1024 THEN name := "SyntaxR" ELSE name := "SyntaxO" END
  762.         END;
  763.         SetStr255(str, name); Sys.GetFNum(str, syntaxFnt);
  764.         SetStr255(str, "Syntax"); Sys.GetFNum(str, osyntaxFnt);
  765.         SetStr255(str, "Helvetica"); Sys.GetFNum(str, helveticFnt);
  766.         IF osyntaxFnt # 0 THEN helveticFnt := osyntaxFnt; syntaxFnt := osyntaxFnt END;
  767.         bitmapSyntax := syntaxFnt # helveticFnt
  768.     END InitFontTrans;
  769.     PROCEDURE InitPort;
  770.     BEGIN
  771.         lineBuf := SYS.ADR(line);
  772.         grafArea.left := MIN(INTEGER); grafArea.right := MAX(INTEGER); grafArea.top := MIN(INTEGER); grafArea.bottom := MAX(INTEGER);
  773.         tpc := -1; spc := -1;
  774.         userClip := Sys.NewRgn(); thePortClip := Sys.NewRgn();
  775.         Sys.SetRectRgn(userClip, thePort.portRect.left, thePort.portRect.top, shadowPort.portRect.right, shadowPort.portRect.bottom);
  776.         Sys.SetRectRgn(thePortClip, thePort.portRect.left, thePort.portRect.top, shadowPort.portRect.right, shadowPort.portRect.bottom)
  777.     END InitPort;
  778.     PROCEDURE InitPalette;
  779.     VAR err, val, adr: LONGINT; res: SET;
  780.     BEGIN
  781.         adr := SYS.ADR (val);
  782.         SYS.PUT (adr, 'q');
  783.         SYS.PUT (adr + 1, 'd');
  784.         SYS.PUT (adr + 2, 'r');
  785.         SYS.PUT (adr + 3, 'w');
  786.         err := Gestalt (val, SYS.VAL (LONGINT, res));
  787.         trueColor := 27 IN res;
  788.         EnterColor(0, 255, 255, 255); EnterColor(1, 255, 0, 0); EnterColor(2, 0, 255, 0); EnterColor(3, 0, 0, 255);
  789.         SetColor(4, 255, 0, 255); SetColor(5, 255, 255, 0); SetColor(6, 0, 255, 255); SetColor(7, 170, 0, 0);
  790.         SetColor(8, 0, 153, 0); SetColor(9, 0, 0, 153); SetColor(10, 119, 0, 204); SetColor(11, 187, 136, 0);
  791.         SetColor(12, 180, 180, 180); SetColor(13, 100, 100, 100); SetColor(14, 20, 20, 20); EnterColor(15, 0, 0, 0);
  792.         shadowColor[0] := whiteColor; shadowColor[1] := blackColor; shadowColor[2] := blackColor; shadowColor[3] := blackColor;
  793.         shadowColor[4] := blackColor; shadowColor[5] := blackColor; shadowColor[6] := blackColor; shadowColor[7] := blackColor;
  794.         shadowColor[8] := blackColor; shadowColor[9] := blackColor; shadowColor[10] := blackColor; shadowColor[11] := blackColor;
  795.         shadowColor[12] := blackColor; shadowColor[13] := blackColor; shadowColor[14] := blackColor; shadowColor[15] := blackColor
  796.     END InitPalette;
  797.     PROCEDURE InitKbdInt;
  798.     VAR err, adr: LONGINT; 
  799.     BEGIN
  800.         kbdIntPC := 0;
  801.         suspended := FALSE; pressed := FALSE;
  802.         suspendQ.Add (Suspended);
  803.         resumeQ.Add (Resumed);
  804.         NEW (vblTask);
  805.         vblTask.qType:=1;
  806.         vblTask.vblCount:=600;
  807.         vblTask.vblPhase:=0;
  808.         p:=Retrace;
  809.         adr:=SYS.ADR (p);
  810.         vblTask.vblAddr:=SYS.VAL (LONGINT, Sys.NewRoutineDesc (adr, 38914, 1));
  811.         err:=Sys.VInstall (vblTask) 
  812.     END InitKbdInt;
  813. (* Initialize Managers *)
  814.     PROCEDURE InitManagers;
  815.         VAR name : Sys.Str255; h: INTEGER;
  816.     BEGIN
  817.         SetStr255 (name, "Oberon.RSRC"); h := Sys.OpenResFile (name);
  818.         Sys.InitGraf(QD.thePort); Sys.InitFonts; Sys. InitWindows; Sys.InitMenus; Sys.TEInit; Sys.InitDialogs(0); Sys.InitCursor;
  819.         Sys.FlushEvents(0, -1); Sys.SetFScaleDisable(TRUE)
  820.     END InitManagers;
  821. BEGIN
  822.     Sys.Assign ("RGBForeColor", SYS.ADR (RGBForeColor));
  823.     Sys.Assign ("Gestalt", SYS.ADR (Gestalt));
  824.     InitManagers;
  825.     neutralizeQ.Init(); restoreQ.Init(); suspendQ.Init(); resumeQ.Init(); backgroundQ.Init(); cmdQ.Init();
  826.     InitBitTrans; InitKeyTrans; InitMenuBar; InitArrow; InitWindow; InitScrap; InitFontTrans; InitPort; InitPalette; InitKbdInt
  827. END Macintosh.
  828.